home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / SCRIPT2A.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-19  |  17.4 KB  |  484 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'funs.int'}
  8. {$include: 'fs_pkg.int'}
  9. {$include: 'database.int'}
  10. {$include: 'load.int'}
  11. {$include: 'script2a.int'}
  12.  
  13. IMPLEMENTATION OF script2a;
  14.  
  15. USES types,globals,utils,funs,fs_pkg,database,load;
  16.  
  17. {DLX Bulletin Board System V7.0
  18.  
  19.  FREEWARE NOTICE
  20.  
  21.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  22.  Anyone who wishes to may run the program, copy it, or modify it for
  23.  any purpose, including commercial gain.}
  24.  
  25. {***INTERFACE TO THE COM_PAX2 ASYNCHRONOUS COMMUNICATIONS PACKAGE***}
  26. {$include: 'com_pax2.int'}
  27.  
  28. {***Interface to the PASASM assembler utilities package***}
  29. {$include: 'pasasm.int'}
  30. {$include: 'newasm.int'}
  31.  
  32. var
  33.   doseqq [EXTERN]: word;
  34.  
  35. function kmatch(consts pat,info : lstring) : boolean;
  36. var
  37.   i,j,k : integer;
  38.   patty,cappy : lstring(screen_cols);
  39. begin
  40.   if pat.len=0 then [kmatch:=true; return];
  41.   kmatch:=false;
  42.   if info.len=0 then return;
  43.   ucs(info,cappy);
  44.   i:=1; j:=ord(pat.len)+1;
  45.   while i<=ord(pat.len) do begin
  46.     if pat[i]=' ' then [i:=i+1; cycle];
  47.     j:=i+scaneq(ord(pat.len)-i,' ',pat,i);
  48.     if j>=ord(pat.len) then [j:=ord(pat.len)+1; break];
  49.     patty.len:=wrd(j-i);
  50.     movesl(ads pat[i],ads patty[1],patty.len);
  51.     k:=positn(patty,cappy,1);
  52.     if k=0
  53.       then return
  54.       else cappy[k]:='x'; {this forbids duplicate key matches}
  55.     i:=j+1; j:=ord(pat.len)+1;
  56.   end {while};
  57.   patty.len:=wrd(j-i);
  58.   movesl(ads pat[i],ads patty[1],patty.len);
  59.   if positn(patty,cappy,1)=0 then return;
  60.   kmatch:=true;
  61. end {kmatch};
  62.  
  63. procedure bbs2a{consts s : lstring; var str : lstring};
  64. var
  65.   i,j,k : integer;
  66.   next_state : task;
  67.   p,p2,p3 : para;
  68.   i4 : integer4;
  69.   fl : boolean;
  70. begin
  71.   next_state:=succ(q[wx].state);
  72.   case q[wx].state of
  73.   delete_old:
  74.     if s=null then
  75.       next_state:=q[wx].return_state
  76.     else if number_query(s,1,MAXINT,q[wx].count) then
  77.       q[wx].index:=0
  78.     else
  79.       [display(bad_userid_txt); next_state:=q[wx].return_state];
  80.   delete_old2:
  81.     [q[wx].index:=q[wx].index+1;
  82.      if q[wx].index<=largest_member_number then
  83.        [if disk2u(q[wx].index) then
  84.           [i4:=date2jd(w^[wx].date_of_call) -
  85.                date2jd(q[wx].your.last_called_date);
  86.            if ord(i4)>=q[wx].count
  87.              then prompt_with(user_delete_txt)
  88.              else next_state:=delete_old2]
  89.         else
  90.           next_state:=delete_old2]
  91.      else
  92.        next_state:=q[wx].return_state];
  93.   delete_old3:
  94.     if nagree(s) then
  95.       [q[wx].your.active:=' ';
  96.        i:=on_line(q[wx].index);
  97.        if i>=0 then
  98.          [w^[i].state:=stopping; q[i].my.active[1]:=' ']
  99.        else
  100.          dbp_member(q[wx].index,q[wx].your);
  101.        mbx(mailpath,q[wx].your.userid,str); mail_delete(str);
  102.        mbx(biopath,q[wx].your.userid,str); mail_delete(str);
  103.        number_of_members:=number_of_members-1;
  104.        display(user_deleted_txt); next_state:=delete_old2]
  105.     else
  106.       next_state:=delete_old2;
  107.   change_level:
  108.     if s=null then
  109.       next_state:=q[wx].return_state
  110.     else if number_query(s,1,largest_member_number,i) then
  111.       [if disk2u(i)
  112.          then prompt_with(enter_level_txt)
  113.          else [display(bad_userid_txt); next_state:=q[wx].return_state]]
  114.     else
  115.       [display(bad_userid_txt); next_state:=q[wx].return_state];
  116.   change_level2:
  117.     if number_query(s,0,9,j) then
  118.       [q[wx].your.userlevel[1]:=chr(ord('0')+j);
  119.        i:=on_line(ivalue(q[wx].your.userid)); q[wx].index:=j;
  120.        if i>=0 then
  121.          [q[i].level:=j; q[i].my.userlevel[1]:=chr(ord('0')+j);
  122.       notify(i,new_level_txt)]
  123.        else
  124.          dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  125.        display(level_changed_txt); next_state:=q[wx].return_state]
  126.     else
  127.       [display(bad_level_txt); next_state:=q[wx].return_state];
  128.   change_mbx:
  129.     [next_state:=q[wx].return_state;
  130.      if s<>null then
  131.        [if number_query(s,1,largest_member_number,i) then
  132.           [if disk2u(i) then
  133.          [q[wx].index:=ivalue(q[wx].your.mbx_max);
  134.           prompt_with(mbx_size_txt); next_state:=change_mbx2]
  135.        else
  136.          display(bad_userid_txt)]
  137.         else
  138.           display(bad_userid_txt)]];
  139.   change_mbx2:
  140.     [next_state:=q[wx].return_state;
  141.      if number_query(s,0,999,q[wx].index) and then
  142.         encode(str,q[wx].index:3) then
  143.        [kopystr(str,q[wx].your.mbx_max);
  144.         i:=on_line(ivalue(q[wx].your.userid));
  145.         if i>=0
  146.           then kopystr(str,q[i].my.mbx_max)
  147.           else dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  148.         display(size_changed_txt)]
  149.      else
  150.        display(bad_size_txt)];
  151.   kill_line:
  152.     if number_query(s,0,number_of_lines,q[wx].index) and then
  153.        w^[q[wx].index].active then
  154.       prompt_with(line_kill_txt)
  155.     else
  156.       [display(bad_line_txt); next_state:=main_menu];
  157.   kill_line2:
  158.     [next_state:=main_menu;
  159.      if agree(s) then
  160.        [if w^[q[wx].index].state=going then
  161.       [w^[q[wx].index].state:=stopping;
  162.        i:=w^[q[wx].index].chat;
  163.        if i>=0 then w^[i].chat:=-1;
  164.        w^[q[wx].index].chat:=-1;
  165.        display(line_killed_txt)]
  166.     else if q[wx].index>0 then {modem line}
  167.       [select_port(q[wx].index); dtr_off;
  168.        if wx>0 then select_port(wx);
  169.            w^[q[wx].index].reset_count:=0;
  170.        if w^[q[wx].index].talking_to = cls
  171.          then w^[q[wx].index].talking_to:=modem
  172.          else w^[q[wx].index].talking_to:=SUCC(w^[q[wx].index].talking_to);
  173.        display(line_killed_txt)]]];
  174.   recycle:
  175.     if number_query(s,1,largest_member_number,q[wx].index) then
  176.       [last_new_user:=q[wx].index-1;
  177.        display(good_recycle_txt); next_state:=main_menu]
  178.     else
  179.       [display(bad_recycle_txt); next_state:=main_menu];
  180.   reset_time:
  181.     [next_state:=q[wx].return_state;
  182.      if s<>null then
  183.        [if number_query(s,1,largest_member_number,i) and then disk2u(i)
  184.           then [prompt_with(reset_really_txt); next_state:=reset_time2]
  185.           else display(bad_userid_txt)]];
  186.   reset_time2:
  187.     [fl:=false; next_state:=q[wx].return_state;
  188.      if agree(s) then
  189.        [copystr('0',q[wx].your.minutes_today); fl:=true];
  190.      if fl then  
  191.        [i:=ivalue(q[wx].your.userid);
  192.     j:=on_line(i);
  193.     if j>=0 then
  194.       [w^[j].connect_sec0:=jt; q[j].minutes_on:=0;
  195.        copystr('0',q[j].my.minutes_today); q[j].minutes_2day:=0]
  196.     else
  197.       dbp_member(i,q[wx].your);
  198.     display(time_reset_txt)]];
  199.   unans1:
  200.     if s=null then
  201.       next_state:=main_menu
  202.     else if number_query(s,1,largest_member_number,i) then
  203.       [if disk2u(i)
  204.          then prompt_with(enter_multiple_txt)
  205.          else [display(bad_userid_txt); next_state:=main_menu]]
  206.     else
  207.       [display(bad_userid_txt); next_state:=main_menu];
  208.   unans2:
  209.     if number_query(s,1,number_of_qaires,j) then
  210.       [for k:=1 to number_of_answers do q[wx].your.mult_answer[j][k]:=' ';
  211.        if j=1 then q[wx].your.mult_answer[1][1]:='Z';
  212.        i:=on_line(ivalue(q[wx].your.userid)); q[wx].index:=j;
  213.        if i>=0 then
  214.          [for k:=1 to number_of_answers do q[i].my.mult_answer[j][k]:=' ';
  215.           if j=1 then q[i].my.mult_answer[1][1]:='Z']
  216.        else
  217.          dbp_member(ivalue(q[wx].your.userid),q[wx].your);
  218.        display(qaire_cleared_txt); next_state:=main_menu]
  219.     else
  220.       [display(bad_multiple_txt); next_state:=main_menu];
  221.   down1:
  222.     [if number_query(s,1,1440,i) then
  223.        [doseqq:=1; shut_down(i)];
  224.      next_state:=main_menu];
  225.   answer:
  226.     [if q[wx].level>=priv_bio
  227.        then display(reans_essay_txt);
  228.      q[wx].qr:=1];
  229.   answer2:
  230.     [if qair[q[wx].qr]<>nil and then
  231.         ((q[wx].level=9) or (q[wx].my.mult_answer[q[wx].qr][1]<>' '))
  232.        then display(reans_mult_txt);
  233.      q[wx].qr:=q[wx].qr+1;
  234.      if q[wx].qr<=number_of_qaires then next_state:=answer2];
  235.   answer3:
  236.     prompt_with(arrow_txt);
  237.   answer4:
  238.     [if str=null or else str[1]=mn[14][2] {Q} then
  239.        next_state:=main_menu
  240.      else if str[1]=mn[14][3] {M} then
  241.        [display(qaire_header_txt); next_state:=questionnaire]
  242.      else if str[1]=mn[14][4] {E} then
  243.        [if q[wx].level>=priv_bio then
  244.           [if essay<>nil then
  245.              [q[wx].return_state:=main_menu;
  246.               display(bio_header_txt); next_state:=bio]
  247.            else
  248.              next_state:=main_menu]
  249.         else
  250.           [display(read_access_txt); next_state:=main_menu]]
  251.      else if str[1]=mn[14][5] {1} then
  252.        q[wx].qr:=1
  253.      else if str[1]=mn[14][6] {2} then
  254.        q[wx].qr:=2
  255.      else if str[1]=mn[14][7] {3} then
  256.        q[wx].qr:=3
  257.      else if str[1]=mn[14][8] {4} then
  258.        q[wx].qr:=4
  259.      else if str[1]=mn[14][9] {5} then
  260.        q[wx].qr:=5
  261.      else
  262.        [display(answer_again_txt); next_state:=answer]];
  263.   answer5:
  264.     [q[wx].qs:=qair[q[wx].qr];
  265.      if q[wx].qs<>nil and then
  266.         ((q[wx].level=9) or (q[wx].my.mult_answer[q[wx].qr][1]<>' ')) then
  267.        [q[wx].index:=1; q[wx].return_state:=main_menu;
  268.         display(nextq_txt); next_state:=mult_ch1a]
  269.      else
  270.        [prompt_with(answer_again_txt); next_state:=answer]];
  271.   browse_prompt:
  272.     if time_check(true) then
  273.       [display(time_limit_txt); next_state:=snip]
  274.     else
  275.       prompt_with(file_number_txt);
  276.   browse:
  277.     [make_number(s,str);
  278.      if number_query(str,1,largest_member_number,i) then
  279.        [if disk2u(i)
  280.           then display(browse_txt)
  281.           else [display(bad_userid_txt); next_state:=q[wx].return_state]]
  282.      else if s=null or else str[1]=mn[8][3] {Q} then
  283.        next_state:=q[wx].return_state
  284.      else
  285.        [display(bad_userid_txt); next_state:=q[wx].return_state]];
  286.   browse_qs1: prompt_with(want_questions_txt);
  287.   browse_qs2:
  288.     [if str=null or else str[1]=mn[8][3] {Q} then
  289.        next_state:=q[wx].return_state
  290.      else if str[1]=mn[1][1] {Y} then
  291.        q[wx].bflag:=true {show questions and answers}
  292.      else if str[1]=mn[1][2] {N} then
  293.        q[wx].bflag:=false {just show the answers}
  294.      else
  295.        [prompt_with(want_questions_txt); next_state:=browse_qs2];
  296.      q[wx].qr:=1; q[wx].qs:=qair[q[wx].qr]; q[wx].bindex:=0];
  297.   browse_qs3:
  298.     if q[wx].qs=nil then
  299.       [while true do {loop until live ?-aire or done}
  300.          [q[wx].qr:=q[wx].qr+1;
  301.           if q[wx].qr>number_of_qaires then
  302.             [mbx(biopath,q[wx].your.userid,str);
  303.              if fs_openr(wx,str)=0 then
  304.                prompt_with(see_biogs_txt)
  305.              else
  306.                [fs_close(wx); next_state:=q[wx].return_state];
  307.              break]
  308.           else if ((q[wx].level=9) or
  309.              (q[wx].my.mult_answer[q[wx].qr][1]<>' ')) and then
  310.                   (q[wx].your.mult_answer[q[wx].qr][1]<>' ') and then
  311.                   (qair[q[wx].qr]<>nil) then
  312.             [q[wx].qs:=qair[q[wx].qr]; q[wx].bindex:=0;
  313.              next_state:=browse_qs3; break]]]
  314.     else
  315.       [p:=newpara(null); w^[wx].output:=p; p2:=p;
  316.        if q[wx].bflag then
  317.          [p:=q[wx].qs^.qna;
  318.           while p<>nill and then p^.msg.len>3 and then p^.msg[1]<>' ' do
  319.            [p3:=newpara(p^.msg);
  320.             p2^.link:=p3; p2:=p3; p:=p^.link]];
  321.        if q[wx].qs^.kind=mult then
  322.      for i:=1 to q[wx].qs^.nans do
  323.        [p3:=get_answer(q[wx].your.mult_answer[q[wx].qr][q[wx].bindex+i],
  324.                q[wx].qs^.qna);
  325.         if p3=nill then break;
  326.         p2^.link:=p3; p2:=p3]
  327.        else
  328.          [p3:=newpara(null); p3^.msg.len:=wrd(q[wx].qs^.nans);
  329.        for i:=1 to q[wx].qs^.nans do
  330.             p3^.msg[i]:=q[wx].your.mult_answer[q[wx].qr][q[wx].bindex+i];
  331.           p2^.link:=p3];
  332.        q[wx].bindex:=q[wx].bindex+q[wx].qs^.nans; q[wx].qs:=q[wx].qs^.link;
  333.        w^[wx].crud:=true; w^[wx].node_type:=nt_display;
  334.        next_state:=browse_qs3];
  335.   browse_biogs:
  336.     if agree(s) then
  337.       [q[wx].bflag:=false; {don't allow & codes in essay answers!}
  338.        next_state:=display_file]
  339.     else
  340.       [fs_close(wx); next_state:=q[wx].return_state];
  341.   goodbye_menu:
  342.       if closing_target>0 and then q[wx].level>=priv_cl
  343.         then prompt_with(goodbye_menu_txt)
  344.         else next_state:=snip;
  345.   goodbye:
  346.     if str=null or else str[1]=mn[1][2] {N} then
  347.       next_state:=snip
  348.     else if str[1]=mn[1][1] {Y} then
  349.       [q[wx].holding:=false; q[wx].flag:=true; {not canned}
  350.        disparas(q[wx].msg_first); {discard any held message}
  351.        q[wx].msg_last:=nill; q[wx].msg_ptr:=nill;
  352.        q[wx].correspondent:=closing_target;
  353.        if disk2u(closing_target) then
  354.          [i:=ivalue(q[wx].your.mbx_count);
  355.           j:=ivalue(q[wx].your.mbx_max);
  356.           if i<max_max_mbx and then ((i<j) or (q[wx].level=9)) then
  357.         [q[wx].return_state:=snip; q[wx].cleanup:='I';
  358.              prepare_header;
  359.          prompt_with(enter_subject_txt); next_state:=enter_subject]
  360.           else
  361.         [display(no_slots_txt); next_state:=snip]]
  362.        else
  363.          [display(bad_userid_txt); next_state:=snip]]
  364.     else if str[1]=mn[8][4] {M} and then q[wx].flag then
  365.       next_state:=main_menu
  366.     else
  367.       [prompt_with(goodbye_menu_txt); next_state:=goodbye];
  368.   db1: {select a new category}
  369.     prompt_with(dbc_txt);
  370.   db2: {process db category}
  371.     if time_check(true) then
  372.       [display(time_limit_txt); next_state:=snip]
  373.     else if str=null then
  374.       next_state:=main_menu
  375.     else if str[1]=mn[9][1] {?} or else
  376.             ((str.len=1) and (str[1]=mn[9][2])) {L} or else
  377.             eq(str,ss[40]) {HELP} then
  378.       [kopylst(path_db,str); konkat(str,'\'); konkat(str,ss[51]); {MENU}
  379.        if fs_openr(wx,str)=0 then
  380.          [q[wx].return_state:=db1; q[wx].bflag:=true;
  381.           next_state:=display_file]
  382.        else
  383.          [fs_close(wx); next_state:=db1]]
  384.     else if str.len=1 and then str[1]=mn[9][3] {S} then
  385.       [prompt_with(which_subdir_txt); next_state:=db2]
  386.     else
  387.       [copylst(path_db,q[wx].pathname);
  388.        konkat(q[wx].pathname,'\'); konkat(q[wx].pathname,str);
  389.        if (not filename_ok(str)) or else (not exist_dir(q[wx].pathname))
  390.          then [display(dbb_txt); next_state:=db1]];
  391.   db3: {display info about particular database}
  392.     [copylst(q[wx].pathname,str); konkat(str,'\'); konkat(str,ss[51]); {MENU}
  393.      if fs_openr(wx,str)=0 then
  394.        [q[wx].return_state:=db3a; q[wx].bflag:=true; next_state:=display_file]
  395.      else
  396.        fs_close(wx)];
  397.   db3a: prompt_with(dbk_txt); {ask for search key}
  398.   db4: {process search key}
  399.     if time_check(true) then
  400.       [display(time_limit_txt); next_state:=snip]
  401.     else if str=null then
  402.       next_state:=db1
  403.     else if str[1]=mn[8][1] {?} or else eq(str,ss[40]) {HELP} then
  404.       next_state:=db3
  405.     else if q[wx].level<priv_db then
  406.       [display(read_access_txt); next_state:=db3a]
  407.     else
  408.       [if q[wx].qa=nill then q[wx].qa:=newpara(null);
  409.        stripx(str,q[wx].qa^.msg);
  410.        if ord(q[wx].qa^.msg.len)<min_db and then q[wx].level<9 then
  411.          [display(shortxt); next_state:=db3a]
  412.        else
  413.          [copylst(q[wx].pathname,str); concat(str,'\HEADER');
  414.           if fs_openr(wx,str)=0 then
  415.             [q[wx].return_state:=db4a; q[wx].bflag:=true;
  416.          next_state:=display_file]
  417.           else
  418.             fs_close(wx)]];
  419.   db4a: {open database}
  420.     [copylst(q[wx].pathname,str); concat(str,'\DATA');
  421.      if fs_openr(wx,str)=0 then
  422.        [q[wx].count:=0; q[wx].index:=0; q[wx].count4:=0;
  423.         if q[wx].xstr=nill
  424.           then q[wx].xstr:=newpara(null)
  425.           else q[wx].xstr^.msg:=null;
  426.         q[wx].return_state:=db6]
  427.      else
  428.        [fs_close(wx);
  429.         display(dbb_txt); next_state:=db1]];
  430.   db5: {search the database, displaying matching lines}
  431.     [q[wx].index:=q[wx].index+1;
  432.      if q[wx].index<5 then {don't hog the disk}
  433.        next_state:=db5
  434.      else
  435.        [q[wx].count:=q[wx].count+1;
  436.         if (not fs_eof(wx)) and then fs_gets(wx,q[wx].xstr^.msg)=0 then
  437.           [next_state:=db5; q[wx].index:=0;
  438.            if kmatch(q[wx].qa^.msg,q[wx].xstr^.msg) then 
  439.              [q[wx].count4:=q[wx].count4+1;
  440.           expand_tabs(q[wx].xstr^.msg); display(q[wx].xstr)]]
  441.         else
  442.           [fs_close(wx); display(dbm_txt)]]];
  443.   db6: {prompt for additional information}
  444.     [copylst(q[wx].pathname,str); concat(str,'\*.TXT');
  445.      if q[wx].count4>0 and then exist_wild(str)
  446.        then prompt_with(moretxt)
  447.        else next_state:=db3a];
  448.   db7: {provide additional information - display .txt file}
  449.     if str=null then
  450.       next_state:=db3a
  451.     else if filename_ok(str) then
  452.       [copylst(q[wx].pathname,str); concat(str,'\'); konkat(str,s);
  453.        konkat(str,'.TXT'); q[wx].count:=0;
  454.        i:=fs_openr(wx,str);
  455.        if i=0 then
  456.          [q[wx].return_state:=db6; q[wx].bflag:=false;
  457.           q[wx].count4:=0; next_state:=display_file]
  458.        else
  459.          [fs_close(wx); q[wx].count:=i;
  460.           display(dbx_txt); next_state:=db6]]
  461.     else
  462.       [display(dbx_txt); next_state:=db6];
  463.   display_file: {bflag means expand & codes}
  464.     if fs_eof(wx) then
  465.       [fs_close(wx); next_state:=q[wx].return_state]
  466.     else
  467.       [p:=newpara(null); q[wx].count:=fs_gets(wx,p^.msg);
  468.        if q[wx].count=0 then
  469.          [expand_tabs(p^.msg); init_fx;
  470.           if q[wx].bflag and then (not substitute(p^.msg)) then
  471.             [kopylst(p^.msg,str); eval(substitute(str));
  472.              kopylst(str,p^.msg)];
  473.           w^[wx].output:=p; w^[wx].crud:=true;
  474.           q[wx].count4:=q[wx].count4+ord(w^[wx].output^.msg[0])+2;
  475.           w^[wx].node_type:=nt_display; next_state:=display_file]
  476.        else
  477.          [dispara(p); fs_close(wx);
  478.           display(io_error_txt); next_state:=q[wx].return_state]];
  479.   end {case};
  480.   q[wx].state:=next_state;
  481. end {bbs2a};
  482.  
  483. END.
  484.